HAM Radio 1997/HAM Radio 1997.iso/vcls/lexscan/lexscan.pas

Pascal/Delphi Source File | 1996-04-08 | 8.5 KB | 334 lines

========
Newsgroups: comp.lang.pascal.delphi.components
Subject: Lexical Scanner [4/4]
From: [e-mail] (Joseph Bui)
Date: 27 Jul 1995 17:00:17 GMT

{
  ************************ LEXSCAN.PAS ************************
}
unit Lexscan;

interface

uses
  TypInfo, Classes, SysUtils, StrUtils;

type
  TCustomScanner = class(TObject)
  private
    FToken: char;
    FTokenString: string;
    FPosition, FLine: longint;
    FStream: TStream;
    procedure SetLine(Value: longint);
    procedure SetPosition(Value: longint);
    function GetTokenFloat: extended;
    function GetTokenInt: longint;
  protected
    property Stream: TStream read FStream write FStream;
  public
    property Token: char read FToken;
    property TokenString: string read FTokenString;
    property TokenFloat: extended read GetTokenFloat;
    property TokenInt: longint read GetTokenInt;
    property Position: longint read FPosition write SetPosition;
    property Line: longint read FLine write SetLine;
    function NextToken: char;
    function LastToken: char;
    function LineString: string;
    constructor Create;
  end;

  TFileScanner = class(TCustomScanner)
  private
    FFileName: string;
  public
    property FileName: string read FFileName;
    constructor Create(AFileName: string);
    destructor Destroy;
  end;

  TStreamScanner = class(TCustomScanner)
  public
    constructor Create(AStream: TStream);
  end;

const
{
  *************************************************************

  Change these constants to customize how the scanner behaves.
  Because of case statements, I did not make these fields of
  the TCustomScanner object as fields.

  *************************************************************
}
  NewLineDelimiter = #10; {line feed}
  EofToken = #0; {End of File token}
  IdentifierToken = #1;
  StringToken = #2;
  IntegerToken = #3;
  FloatToken = #4;
  BlackSpaces: TChars = [#33..#126];
  Identifiers: TChars = [#48..#57, #65..#90, #97..#122]; {SetAlphas SetDigits}
  IdentifierSymbols: TChars = [#65..#90, #95, #97..#122]; {SetAlphas, '_'}
  Tokens: TChars = [#33..#47, #58..#64, #91..#94, #96, #123..#126]; {SetBlackSpaces !SetIdentifiers}
  {NewLineDelimiter MUST be in WhiteSpaces}
  WhiteSpaces: TChars = [#0..#32, #127];

{
  These constants are for identifying pascal numbers. Changing these values
  will cause TokenInt and TokenFloat to raise EConvertErrors.
}
  StringDelimiter = #39; {''''}
  HexDelimiter = #36; {'$'}
  DecimalDelimiter = '.'; {Can't put in DecimalSeparator...}
  ExponentDelimiter1 = #69; {'E'}
  ExponentDelimiter2 = #101; {'e'}
  PositiveDelimiter = #43; {'+'}
  NegativeDelimiter = #45; {'-'}
  SetAlphas: TChars = [#65..#90, #95, #97..#122]; {'A'..'Z', 'a'..'z'}
  SetDigits: TChars = [#48..#57]; {'0'..'9'}
  SetHexDigits: TChars = [#48..#57, #65..#70, #97..#102]; {SetDigits, 'A'..'F', 'a'..'f'}
  SetNumbers: TChars = [HexDelimiter, PositiveDelimiter, NegativeDelimiter,
      DecimalDelimiter, #48..#57, #65..#70, #97..#102]; {SetHexDigits, '+', '-', '.', '$'}

implementation

{
  TCustomScanner ***********************************************
}
constructor TCustomScanner.Create;
begin
  inherited Create;
  FToken:=EofToken;
  FTokenString:=Null;
  FPosition:=0;
  FLine:=0;
end;

procedure TCustomScanner.SetLine(Value: longint);
var
  Buffer: array[0..255] of char;
  APChar: PChar;
begin
  APChar:=nil;
  if Value < 0 then Value:=0;
  if Value <= FLine then
  begin
    FStream.Seek(0, 0);
    FLine:=0;
  end;
  while (FLine <> Value) and (FStream.Position < FStream.Size) do
  begin
    Buffer[FStream.Read(Buffer, 255)]:=#0;
    APChar:=@Buffer;
    repeat
      APChar:=StrScan(APChar, NewLineDelimiter);
      if APChar <> nil then
      begin
        Inc(FLine);
        Inc(APChar);
      end;
    until (FLine = Value) or (APChar = nil);
  end;
  if APChar <> nil then
    FStream.Seek(-StrLen(APChar), 1);
  NextToken;
end;

procedure TCustomScanner.SetPosition(Value: longint);
begin
  if Value >= FStream.Size then
  begin
    FStream.Seek(0,2);
    NextToken;
    exit;
  end;
  if Value < 0 then
    Value:=0;
  Line:=0;
  repeat
    Line:=FLine + 1;
  until FStream.Position >= Value;
  repeat
    LastToken;
  until FPosition <= Value;
end;

function TCustomScanner.NextToken: char;
var
  AChar: char;
  Done: boolean;
begin
  FTokenString:=Null;
  FToken:=#0;
  repeat
    Done:=Stream.Read(AChar, 1) = 0;
    if (AChar = NewLineDelimiter) then
      Inc(FLine);
  until not (AChar in WhiteSpaces) or Done;
  if Done then
  begin
    FPosition:=Stream.Size;
    FToken:=EofToken;
    FTokenString:=Null;
  end
  else
  begin
    FPosition:=Stream.Position - 1;
    if (AChar in IdentifierSymbols) then
    begin
      FToken:=IdentifierToken;
      repeat
        AppendStr(FTokenString, AChar);
        Done:=Stream.Read(AChar, 1) = 0;
      until not (AChar in Identifiers) or Done;
      Stream.Seek(FPosition + Length(FTokenString), 0);
    end
    else
    begin
      case AChar of
        StringDelimiter :
        begin
          FToken:=StringToken;
          Done:=Stream.Read(AChar, 1) = 0;
          while not Done and (AChar <> StringDelimiter) do
          begin
            AppendStr(FTokenString, AChar);
            Stream.Read(AChar, 1);
          end;
        end;
        '$', '+', DecimalDelimiter, '-', '0'..'9' : {SetNumberSymbols, DO NOT CHANGE}
        begin
          FToken:=AChar;
          AppendStr(FTokenString, AChar);
          repeat
            Done:=Stream.Read(AChar, 1) = 0;
            AppendStr(FTokenString, AChar);
          until not (AChar in SetNumbers) or Done;
          repeat
            FTokenString[0]:=Chr(Length(FTokenString) - 1);
            if IsAnInt(FTokenString) then
              FToken:=IntegerToken
            else
              if IsAFloat(TokenString) then
                FToken:=FloatToken;
          until (FToken = IntegerToken) or (FToken = FloatToken) or (Length(FTokenString) = 1);
          Stream.Seek(FPosition + Length(FTokenString), 0);
        end;
      else
        begin
          FToken:=AChar;
          FTokenString:=AChar;
        end;
      end;
    end;
  end;
  Result:=FToken;
end;

function TCustomScanner.GetTokenFloat: extended;
begin
  Result:=StrToFloat(FTokenString);
end;

function TCustomScanner.GetTokenInt: longint;
begin
  Result:=StrToInt(FTokenString);
end;

function TCustomScanner.LastToken: char;
var
  NewPosition, LastPosition, LastLine: longint;
  AChar: char;
begin
  if FPosition = 0 then
  begin
    Result:=FToken;
    exit;
  end;
  LastPosition:=FPosition;
  NewPosition:=FPosition;
  LastLine:=FLine - 1;
  repeat
    Line:=LastLine;
    Dec(LastLine);
    while FPosition < LastPosition do
    begin
      NewPosition:=FPosition;
      NextToken;
    end;
  until (FPosition = LastPosition) and (NewPosition < LastPosition);
  repeat
    FStream.Seek(-1, 1);
    FStream.Read(AChar, 1);
    FStream.Seek(-1, 1);
    if AChar = NewLineDelimiter then
      Dec(FLine);
  until FStream.Position = NewPosition;
  Result:=NextToken;
end;

function TCustomScanner.LineString: string;
var
  OldStream, OldPosition: longint;
  OldToken: char;
  OldString: string;
  Buffer: array[0..255] of char;
  APChar: PChar;
begin
  OldStream:=Stream.Position;
  OldPosition:=FPosition;
  OldToken:=FToken;
  OldString:=FTokenString;
  Line:=FLine;
  Stream.Seek(FPosition, 0);
  Buffer[Stream.Read(Buffer, 255)]:=#0;
  APChar:=StrScan(@Buffer, NewLineDelimiter);
  if APChar <> nil then
    {assumes LF -> CR/LF}
    if ((APChar - 1)^ = #13) and (NewLineDelimiter = #10) then
      (APChar - 1)^:=#0
    else
      APChar^:=#0;
  Result:=StrPas(@Buffer);
  Stream.Seek(OldStream, 0);
  FPosition:=OldPosition;
  FToken:=OldToken;
  FTokenString:=OldString;
end;

{
  TFileScanner *************************************************
}
constructor TFileScanner.Create(AFileName: string);
begin
  inherited Create;
  if not FileExists(AFileName) then
    Exit;
  Stream:=TFileStream.Create(AFileName, fmOpenRead);
  FFileName:=AFileName;
  Stream.Seek(0,0);
  NextToken;
end;

destructor TFileScanner.Destroy;
begin
  Stream.Free;
  inherited Destroy;
end;

{
  TStreamScanner ***********************************************
}
constructor TStreamScanner.Create(AStream: TStream);
begin
  Stream:=AStream;
  Stream.Seek(0,0);
  NextToken;
end;

end.